home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / os2 / lxlt113.zip / SOURCES / COLMNG.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-06  |  9KB  |  331 lines
  1. Program PM_Colors_Manager;
  2.  
  3. uses crt, dos, strOp, os2def, os2base, os2pmapi, miscUtil, Helpers;
  4.  
  5. const
  6.     Version    = '1.0.0';
  7.     srcApp     : pChar = 'PM_Colors';
  8.     dstApp     : pChar = 'PM_Default_Colors';
  9.     actNothing = 0;
  10.     actLoad    = 1;
  11.     actSave    = 2;
  12.     actReset   = 3;
  13.     actCurrent = 4;
  14.     actCustom  = 5;
  15.     actView    = 6;
  16.  
  17. var Action     : Byte;
  18.     AltFile,
  19.     PalFile,
  20.     CustPal    : PathStr;
  21.     UserINI    : hIni;
  22.     appHAB     : Hab;
  23.  
  24. Procedure TypeHelp;
  25. begin
  26.  Writeln('├ Usage: ColMng {ResourceFile} [/?HACLSRVD]');
  27.  Writeln('├ /?,H  - Display this help text');
  28.  Writeln('├ /A{#} - Set alternative .INI file (for Save & Load operations)');
  29.  Writeln('├ /C{#} - Set custom palette (identify by name; empty for help)');
  30.  Writeln('├ /L{#} - Load color palette from resource file; empty for default');
  31.  Writeln('├ /S{#} - Save color palette into resource file; empty for default');
  32.  Writeln('├ /R{#} - Remove specified palette; empty for default');
  33.  Writeln('├ /V{#} - View sections in .INI file beginning from # (PM_ to list schemes)');
  34.  Writeln('├ /D    - Set PM default colors to current colors');
  35.  Writeln('├         Useful if you are using different from WPS shell (i.e. FILEBAR)');
  36.  TextAttr:=$08;
  37.  Writeln('├┤Example: ColMng /s MyColors.Ini');
  38.  Writeln('├┤         ColMng /lPM_Windows_Colors MyColors.Ini');
  39.  Writeln('├┤         ColMng /rPM_Lilac_Colors');
  40.  Writeln('└┤         ColMng /d');
  41.  Halt(1);
  42. end;
  43.  
  44. Procedure PaletteHelp;
  45. begin
  46.  Writeln('├ Scheme names used by PM color setup (case sensitive; add `PM_` before):');
  47.  Writeln('├ Windows_Colors      Khaki_Colors      Lilac_Colors       Blush_Colors');
  48.  Writeln('├ Boston_Colors       Southwest_Colors  Summer_Days_Colors Clovers_Colors');
  49.  Writeln('├ Blue_Jeans_Colors   Lemonade_Colors   Spring_Glen_Colors Lcd_Colors');
  50.  Writeln('├ Evening_Rose_Colors Sunshine_Colors   Dusty_Dark_Colors  Mono_Colors');
  51.  Writeln('├ Sea_Green_Colors    Mint_Twist_Colors Night_Music_Colors System_Colors');
  52.  Writeln('├ Blueberry_Colors    Blue_Sky_Colors   Ocean_Colors       OS2_Default_Colors');
  53.  Writeln('├ All mentioned palettes are located in OS2SYS.INI, not in OS2.INI');
  54.  TextAttr:=$08;
  55.  Writeln('└┤Example: ColMng /cPM_Blue_Sky_Colors');
  56.  Halt(1);
  57. end;
  58.  
  59. Procedure Error(No : Byte);
  60. begin
  61.  TextAttr := $04;
  62.  case No of
  63.   1 : Writeln('└┤Cannot open specified INI file');
  64.   2 : Writeln('└┤Source palette not found in INI file');
  65.   3 : Writeln('└┤Cannot get sections list for specified INI file');
  66.  end;
  67.  Halt(No + 1);
  68. end;
  69.  
  70. Function MyParmHandler(var S : String) : Byte;
  71. var tempS : String;
  72.  
  73. Procedure GetCustName;
  74. var I : Longint;
  75. begin
  76.  CustPal := ''; I := 2;
  77.  While (I <= length(S)) and (S[I] > ' ') do
  78.   begin CustPal := CustPal + S[I]; Inc(I); end;
  79.  MyParmHandler := pred(I);
  80. end;
  81.  
  82. begin
  83.  MyParmHandler := 1;
  84.  case upCase(S[1]) of
  85.   'A' : begin
  86.          tempS := CustPal;
  87.          GetCustName;
  88.          AltFile := CustPal + #0;
  89.          CustPal := tempS;
  90.         end;
  91.   'L' : begin
  92.          Action := actLoad;
  93.          GetCustName;
  94.         end;
  95.   'S' : begin
  96.          Action := actSave;
  97.          GetCustName;
  98.         end;
  99.   'R' : begin
  100.          Action := actReset;
  101.          GetCustName;
  102.         end;
  103.   'V' : begin
  104.          Action := actView;
  105.          GetCustName;
  106.         end;
  107.   'D' : Action := actCurrent;
  108.   'C' : begin
  109.          Action := actCustom;
  110.          GetCustName;
  111.          if CustPal = '' then PaletteHelp;
  112.         end;
  113.   else TypeHelp;
  114.  end;
  115. end;
  116.  
  117. Function MyNameHandler(var S : String) : Byte;
  118. var I : Longint;
  119. begin
  120.  I := 0; While (S[I + 1] > ' ') do Inc(I);
  121.  MyNameHandler := I;
  122.  PalFile := Copy(S, 1, I);
  123. end;
  124.  
  125. Procedure KillOSshell;
  126. begin
  127.  textAttr := $0C;
  128.  Writeln('├ In order changes to take effect you must reload your RunWorkPlace.');
  129.  Writeln('├ If you are running WorkPlaceShell you must reboot, otherwise you can');
  130.  Writeln('├ simply kill your shell (Ctrl/Esc, then cursor on FILEBAR, then DEL)');
  131. end;
  132.  
  133. Procedure OpenProfile(Mode : Byte);
  134. begin
  135.  if (Mode = 1) and (not FileExist(PalFile))
  136.   then Error(1);
  137.  PalFile := PalFile + #0;
  138.  UserINI := prfOpenProfile(appHAB, @PalFile[1]);
  139.  if UserINI = 0 then Error(1);
  140. end;
  141.  
  142. Procedure CopyApp(srcIni, dstIni : hIni; srcApp, dstApp : pChar);
  143. var dataSize,
  144.     bufSize    : uLong;
  145.     dataBuff,
  146.     keyNames   : pArrOfByte;
  147.     I,KeyCnt   : Longint;
  148.     Key        : pChar;
  149. begin
  150.  if not prfQueryProfileSize(srcIni, srcApp, nil, bufSize)
  151.   then Error(2);
  152.  GetMem(keyNames, bufSize);
  153.  prfQueryProfileData(srcIni, srcApp, nil, keyNames^, bufSize);
  154.  KeyCnt := 0;
  155.  For I := 1 to CountASCIIZ(keyNames^, bufSize) do
  156.   begin
  157.    Key := GetASCIIZptr(keyNames^, I);
  158.    if PrfQueryProfileSize(srcIni, srcApp, Key, dataSize)
  159.     then begin
  160.           GetMem(dataBuff, dataSize);
  161.           prfQueryProfileData(srcIni, srcApp, Key, dataBuff^, dataSize);
  162.           prfWriteProfileData(dstIni, dstApp, Key, dataBuff^, dataSize);
  163.           FreeMem(dataBuff, dataSize);
  164.           Inc(KeyCnt);
  165.          end;
  166.   end;
  167.  FreeMem(keyNames, bufSize);
  168.  if KeyCnt = 0
  169.   then Writeln('├ Cannot find selected keyword in INI file')
  170.   else Writeln('├ ', KeyCnt, ' total key values copied');
  171. end;
  172.  
  173. Procedure CheckAltFile(var srcINI : hINI);
  174. begin
  175.  if AltFile <> ''
  176.   then begin
  177.         if Pos('os2.ini', LowStrg(AltFile)) <> 0
  178.          then srcINI := hIni_UserProfile
  179.          else
  180.         if Pos('os2sys.ini', LowStrg(AltFile)) <> 0
  181.          then srcINI := hIni_SystemProfile
  182.          else
  183.         srcINI := prfOpenProfile(appHAB, @AltFile[1]);
  184.         if srcINI = 0 then Error(1);
  185.        end;
  186. end;
  187.  
  188. Procedure CloseAltFile(var srcINI : hINI);
  189. begin
  190.  if (srcIni <> hIni_SystemProfile) and
  191.     (srcIni <> hIni_UserProfile)
  192.   then prfCloseProfile(srcIni);
  193. end;
  194.  
  195. Procedure DoLoad;
  196. var dstINI : hINI;
  197. begin
  198.  if custPal <> ''
  199.   then begin
  200.         custPal := custPal + #0;
  201.         dstApp := @custPal[1];
  202.         dstINI := hIni_SystemProfile;
  203.        end
  204.   else dstINI := hIni_UserProfile;
  205.  if PalFile = '' then TypeHelp;
  206.  CheckAltFile(dstINI);
  207.  Writeln('├ Loading ', dstApp, ' from ', PalFile);
  208.  OpenProfile(1);
  209.  CopyApp(UserINI, dstINI, dstApp, dstApp);
  210.  KillOSshell;
  211.  CloseAltFile(dstIni);
  212. end;
  213.  
  214. Procedure DoSave;
  215. var srcINI : hINI;
  216. begin
  217.  if custPal <> ''
  218.   then begin
  219.         custPal := custPal + #0;
  220.         dstApp := @custPal[1];
  221.         srcINI := hIni_SystemProfile;
  222.        end
  223.   else srcINI := hIni_UserProfile;
  224.  if PalFile = '' then TypeHelp;
  225.  CheckAltFile(srcINI);
  226.  Writeln('├ Saving ', dstApp, ' to ', PalFile);
  227.  OpenProfile(0);
  228.  CopyApp(srcINI, UserINI, dstApp, dstApp);
  229.  CloseAltFile(srcIni);
  230. end;
  231.  
  232. Procedure DoReset;
  233. begin
  234.  if custPal <> ''
  235.   then begin
  236.         custPal := custPal + #0;
  237.         dstApp := @custPal[1];
  238.        end;
  239.  Write('├ Removing ', dstApp, ' from ');
  240.  if PalFile = ''
  241.   then begin
  242.         Writeln('user INI file');
  243.         UserINI := hIni_UserProfile;
  244.        end
  245.   else begin
  246.         Writeln(PalFile);
  247.         OpenProfile(1);
  248.        end;
  249.  prfWriteProfileData(UserINI, dstApp, nil, dstApp, 0);
  250.  KillOSshell;
  251. end;
  252.  
  253. Procedure DoCurrent(SrcINI : hIni);
  254. begin
  255.  Writeln('├ Setting ', dstApp, ' to ', srcApp);
  256.  CopyApp(SrcINI, hIni_UserProfile, srcApp, dstApp);
  257.  KillOSshell;
  258. end;
  259.  
  260. Procedure DoCustom;
  261. begin
  262.  CustPal := CustPal + #0;
  263.  srcApp := @CustPal[1];
  264.  DoCurrent(hIni_SystemProfile);
  265. end;
  266.  
  267. Procedure DoView;
  268. var Buffer  : pChar;
  269.     I,
  270.     bufSize : uLong;
  271.     S       : String;
  272. begin
  273.  Write('├ Viewing sections in ');
  274.  if Pos('os2.ini', LowStrg(PalFile)) <> 0
  275.   then begin
  276.         Writeln('user INI file');
  277.         UserINI := hIni_UserProfile;
  278.        end
  279.   else
  280.  if PalFile = ''
  281.   then begin
  282.         Writeln('system INI file');
  283.         UserINI := hIni_SystemProfile;
  284.        end
  285.   else begin
  286.         Writeln(PalFile);
  287.         OpenProfile(1);
  288.        end;
  289.  if not prfQueryProfileSize(UserINI, nil, nil, bufSize)
  290.   then Error(3);
  291.  GetMem(Buffer, bufSize);
  292.  prfQueryProfileData(UserINI, nil, nil, Buffer^, bufSize);
  293.  For I := 1 to CountASCIIZ(Buffer^, bufSize) do
  294.   begin
  295.    S := GetASCIIZ(Buffer^, I);
  296.    if Copy(S, 1, length(CustPal)) = CustPal
  297.     then Writeln('├ ', S);
  298.   end;
  299.  FreeMem(Buffer, bufSize);
  300. end;
  301.  
  302. Procedure MyExitProc;
  303. begin
  304.  if UserINI <> 0
  305.   then prfCloseProfile(UserINI);
  306.  WinTerminate(appHAB);
  307.  Halt(ExitCode);
  308. end;
  309.  
  310. begin
  311.  appHAB := WinInitialize(0);
  312.  ExitProc := @myExitProc;
  313.  TextAttr := $0F;
  314.  Writeln('┌─[PM colors manager]─────────────────────────[Version '+Version+']─┐');
  315.  Writeln('├ Copyright (c) 1995 by FRIENDS software  All Rights Reserved ┘');
  316.  TextAttr := $07;
  317.  ParseCommandLine(#1, MyParmHandler, MyNameHandler);
  318.  case Action of
  319.   actNothing : TypeHelp;
  320.   actLoad    : DoLoad;
  321.   actSave    : DoSave;
  322.   actReset   : DoReset;
  323.   actCurrent : DoCurrent(hIni_UserProfile);
  324.   actCustom  : DoCustom;
  325.   actView    : DoView;
  326.  end;
  327.  TextAttr := $08;
  328.  Writeln('└┤Done.');
  329. end.
  330.  
  331.